 page
*
* "detree" deallocates blocks from tree files. 
*
* it is assumed that the device preselected and the 'gbuf' may be used.
*
* on entry the following values must be set: 
*   stortype = storage type in upper nibble, lower nibble is undisturbed.
*   firstbl & firstbh = first block of file (index or data)
*   deblock = 0 (see below)
*   dtree = ptr to 1st block with stuff to be deallocated at tree level.
*   dsap = ptr to 1st block at sapling level
*   dseed = byte (0-511) position to be zeroed from (inclusive).
*
* on exit:
*   stortype = modified result of storage type (if applicable)
*   firstbl & h = modified if storage type changed.
*   deblock = total number of blocks freed at all levels.
*   dtree, dsap, dseed unchanged.
*
* to trim a tree to a seed file, both dtree and dsap must be zero.
* to go from tree to sapling, dtree alone must be zero.
*
*
detree lda stortype ;which flavor of tree?
 cmp #$20 ;is it a 'seed' (<=$1f)
 bcc seedeal ;branch if yes.
 cmp #$30 ;maybe a 'sapling'?
 bcc sapdeal
 cmp #$40 ;well, at least be certain it's a 'tree'.
 bcc tredeal ;branch if it is.
* ----------------- see rev note 22 ----------------------------
 lda #alcerr ;block allocation error
* --------------------------------------------------------------
 jsr sysdeath ;should never have been called.
*
seedeal jmp seedel0
sapdeal jmp sapdel0
*
*
tredeal lda #$80 
 sta topdest ;for tree top, start at end, work backwards.
tredel1 jsr drdfrst ;read specified first block into gbuf.
 bcs bummerr ;return all errors.
 ldy topdest ;get current pointer to top indexes.
 cpy dtree ;have enough sapling indexes been deallocated?
 beq tredel7 ;yes, now deallocate top guys!
 ldx #7 ;buffer up to 8 sapling index block addrs.
tredel2 lda gbuf,y ;fetch low block address
 sta dealbufl,x ; and save it.
 ora gbuf+$100,y ;is it a real block that is allocated?
 beq tredel3 ;branch if phantom block.
 lda gbuf+$100,y ;fetch hi block addr.
 sta dealbufh,x ; and save it.
 dex ;decrement and test for dealc buf filled.
 bmi tredel5 ;branch if we've fetched 8 addresses.
*
 page
tredel3 dey ;look now for end of deallocation limit.
 cpy dtree ; is this the last position on tree level?
 bne tredel2 ;branch if not.
 iny
 lda #0 ;fill rest of dealc buffer with nul addresses.
tredel4 sta dealbufl,x
 sta dealbufh,x
 dex
 bpl tredel4 ;loop until filled.
*
tredel5 dey ;decrement to prepare for next time.
 sty topdest ;save index.
 ldx #7
tredel6 stx dtmpx ;save index to dealc buf.
 lda dealbufl,x
 sta bloknml
 ora dealbufh,x ;are we finished?
 beq tredel1 ;branch if done with this level.
 lda dealbufh,x ;complete address with hi byte,
 sta bloknmh
 jsr rdgbuf ;read sapling level into gbuf.
 bcs bummerr ;return any errors.
 jsr dealblk ;go free all data indexes in this block.
 bcs bummerr
 skp 1
**************** see rev note #73 ******************
 jsr wrtgbuf
 bcs bummerr
 skp 1
 ldx dtmpx ;restore index to dealc buff.
 dex ;are there more to free?
 bpl tredel6 ;branch if there are.
 bmi tredel1 ;branch always to do next bunch.
*
dtredone equ *
dsapdone clc ;indicate no errors.
bummerr rts ;return point for errors.
*
*
tredel7 ldy dtree ;now deallocate all tree level
 iny ; blocks greater than specified block.
 jsr dalblk1 ;(tree top in gbuf)
 bcs bummerr ;report any errors.
 jsr wrtgbuf ;write updated top back to disk.
 bcs bummerr
 ldy dtree ;no figure out if tree can become sapling
 beq tredel8 ;branch if it can!
 lda gbuf,y ;otherwise, continue with partial
 sta bloknml ; deallocation of last sapling index.
 ora gbuf+$100,y ;is there such a sapling index block?
 beq dtredone ;all done if not!
 lda gbuf+$100,y ;read in sapling level to be modified.
 sta bloknmh
 jsr rdgbuf ;read 'highest' sapling index into gbuf.
 bcc sapdel1
 rts
*
*
tredel8 jsr shrink ;shrink tree to sapling.
 bcs bummerr
*
*
sapdel0 jsr drdfrst ;read specified only sapling level index into gbuf.
 bcs bummerr
sapdel1 ldy dsap ;fetch pointer to last of desirable indexes
 iny ; bump to the first undesirable.
 beq sapdel2 ;branch if all are desirable.
 jsr dalblk1 ;deallocate all indexes above appointed.
 bcs bummerr
 jsr wrtgbuf ;update disk with remaining indexes.
 bcs bummerr
*
sapdel2 ldy dsap ;now prepare to cleanup last data block.
 beq sapdel4 ;branch if there is a posiblity of making it a seed.
sapdel3 lda gbuf,y ;fetch low order data block addr.
 sta bloknml
 ora gbuf+$100,y ;is it a real block?
 beq dsapdone ;we're done if not.
 lda gbuf+$100,y
 sta bloknmh
 jsr rdgbuf ;go read data block into gbuf.
 bcc seedel1 ;branch if good read
 rts ;otherwise return error.
*
sapdel4 lda dtree ;is both tree and sap levels zero?
 bne sapdel3 ;branch if not.
 jsr shrink ;reduce this sap to a seed.
 bcs bumerr1
*
* if no error, drop into seedel0
*
seedel0 jsr drdfrst ;go read only data block.
 bcs bumerr1 ;report any errors.
seedel1 ldy dseed+1 ;check hi byte for no deletion
 beq seedel2 ;branch if all of second page is to be deleted.
 dey ;if dseed>$200 then were all done!
 bne dseedone ;branch if thats the case.
 ldy dseed ;clear only bytes >= dseed.
seedel2 lda #0
seedel3 sta gbuf+$100,y ;zero out unwanted data.
 iny
 bne seedel3
 ldy dseed+1 ;was that all?
 bne seedel5 ;branch if it was.
 ldy dseed
seedel4 sta gbuf,y
 iny
 bne seedel4
seedel5 jmp wrtgbuf ;update data block to disk.
*
dseedone clc ;indicate no error.
bumerr1 rts ;return error status.
*
drdfrst lda firstbl ;read specified first block into gbuf.
 ldx firstbh
 jmp rdblk ;go do it!
 skp 1
**************** see rev note #73 ******************
 skp 1
************************************************
* beware that dealloc may bring in a new bitmap block and
* may destroy locations 46 and 47 which use to point
* to the current index block.
************************************************
 skp 1
shrink ldx firstbh ;first deallocate top block.
 txa
 pha
 lda firstbl
 pha ;save block address of this index block
 jsr dealloc ;go do it.
 pla
 sta bloknml ;set master of sapling index block address
 pla
 sta bloknmh ;
 bcs bumerr2 ;report any errors.
 lda gbuf ;get first block at lower level
 sta firstbl
 lda gbuf+$100
 sta firstbh
 skp 1
 ldy #$0
 jsr swapme
 skp 1
 sec ;now change file type, from
 lda stortype ; tree to sapling,
 sbc #$10 ; or from sapling to seed!
 sta stortype
 skp 1
 jsr wrtgbuf
 skp 1
*clc
bumerr2 rts ;return error status.
*
*
dealblk ldy #0 ;begin at the beginning.
dalblk1 lda bloknml ;save disk address of
 pha ; gbuf's data.
 lda bloknmh
 pha
dalblk1a sty saptr ;save current index.
 lda gbuf,y ;get address (low) of block to be deallocated.
 cmp gbuf+$100,y ;test for nul block.
 bne dalblk2 ;branch if not nul.
 cmp #0
 beq dalblk3 ;skip it if nul.
dalblk2 ldx gbuf+$100,y ;get the rest of the block address.
 jsr dealloc ;free it up on volume bit map.
 bcs dalblkerr ;return any error.
 ldy saptr ;get index to sapling level index block again.
 skp 1
 jsr swapme
 skp 1
*
**************** see rev note #73 ******************
****************** see rev note #49 *****************
******************** see rev note #41 ***********************
*
* lda delflag ; are we being called from delete?
* bne dalblk3 ; yes, so don't zero index blocks!!
*************************************************************
*lda #0
*sta gbuf,y
*sta gbuf+$100,y ;remove address form index block.
dalblk3 iny ;point at next block address.
 bne dalblk1a ;branch if more to deallocate (or test).
 clc ;indicate no error.
dalblkerr tax ;save error code, if any. 
 pla ;restore bloknml&h 
 sta bloknmh 
 pla
 sta bloknml
 txa ;restore return code.
 rts
*
 skp 1
**************** see rev note #73 ******************
 skp 1
swapme lda delflag ;are we swapping or 0ing ?
 bne swapme1 ;skip if swapping
 tax  ;make x a 0
 skp 1
****************** see rev note 75 ********************
 beq swapme2 ;0 the index  (always taken)
 skp 1
swapme1 ldx gbuf+$100,y ;get index, hi
 lda gbuf,y ;get index, lo
 skp 1
swapme2 sta gbuf+$100,y ;save index, hi
 txa
 sta gbuf,y ;save index, lo
 rts ;we done
